home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / fido / RFS275.lha / rexx / RFS.rexx < prev    next >
OS/2 REXX Batch file  |  1995-04-17  |  31KB  |  728 lines
  1. /**/
  2. v="$VER: RFS Rexx WPL Mailer File Request Server  Williamson 55.07"
  3. Parse Arg wplport Line baud host_address Infile Listed remote_address remote_sysop
  4. if arg()=0 then EXIT
  5. script="RFS"
  6. xfq_site_object=XfqGetAddress(remote_address)
  7. if ~XfqHoldMailer(xfq_site_object) then do
  8.     address "LOGPROC" 'Putlog 'loggroup time() Line script 'HOLD Failed:'XFQERRORMSG remote_address
  9.     drop XFQERRORCODE XFQERRORMSG
  10. end
  11. TRUE=1;FALSE=0
  12. verbose=FALSE;debug=FALSE /*if debug TRUE, files not queued, req not deleted*/
  13. if ~show('L', "rexxdossupport.library") then
  14.     if ~addlib("rexxdossupport.library",0,-30,2) then do
  15.         say "Couldn't access WB2 rexxdossupport.library !"
  16.         exit 20
  17.     end
  18. Options failat 99
  19. Options Results
  20. numeric digits 14
  21. Signal On Syntax
  22. Signal On IOErr
  23. sv="v"right(v,5)
  24. if upper(wplport)="DEBUG" then do
  25.     Parse Arg junk wplport Line Baud host_address Infile Listed remote_address remote_sysop
  26.     verbose=TRUE;debug=TRUE;loggroup='RFS'
  27.     address "LOGPROC" 
  28.     'OpenLog RFS w RAW:0/0/600/200/RFS'
  29.     'AddLogGroup RFS RFS'
  30.     'Putlog 'loggroup time() Line script 'Debug Enabled'
  31.     address
  32. end
  33.  
  34. cr='0D'x;lf="0A"x;quote='"'
  35. LogBuf="";AccBuf="";MsgBuf=""
  36. HydraFiles=""
  37. if debug then loggroup="RFS"
  38. else loggroup=lower(wplport)"wpl"
  39. call setconfig
  40.  
  41. if Priority~=0 then oldpri=Pragma('Priority',Priority)
  42. parse var remote_address hisaddress.domain '#' hisaddress.zone ':' hisaddress.net '/' hisaddress.node '.' hisaddress.point
  43. remote_sysop=strip(remote_sysop)
  44. if remote_sysop="" then remote_sysop="Unknown Sysop"
  45. address "LOGPROC" 'Putlog 'loggroup time() Line script sv 'Serving 'remote_sysop' of 'remote_address' on 'upper(wplport)line
  46. LogBuf=LogBuf||date() time()' RFS Serving 'remote_sysop' of 'remote_address' on 'upper(wplport)||line||lf
  47.  
  48. XQ_DELETE=1     /* Delete file after sending             */
  49. XQ_IMMEDIATE=4  /* Send only if session currently up     */
  50. DTPRI_CRASH=50
  51.  
  52. tlist="T:rfs_t"Line;ulist="T:rfs_u"Line
  53. a=0;b=0;i=0;x=0;Sent=0;TBytes=0
  54.  
  55. parse var host_address myaddress.domain '#' myaddress.zone ':' myaddress.net '/' myaddress.node '.' myaddress.point
  56.  
  57. if pos("GRAB",InFile)=0 then Human=FALSE
  58. else do
  59.     Human=TRUE
  60.     AcctPath=AcctPath"H/"
  61.     if ~listed then MaxBytes=MaxHBytes
  62.     else do
  63.         MaxHDaily=MaxHDaily*10 
  64.         MaxBytes=baud*100
  65.     end
  66. end
  67.  
  68. /* exclusion processing */
  69. if debug then address "LOGPROC" 'Putlog 'loggroup time() Line "Exclusion processing"
  70. if ~ReqHuman & Human then do
  71.     address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Humans excluded!"
  72.     LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Humans excluded'lf
  73.     call writepkt('File request terminated: Humans are excluded at this time.'cr)
  74.     Signal GoodBye
  75. end
  76. if ~ReqPoint & (hisaddress.point > "0") then do
  77.     address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Points Not Supported!"
  78.     LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Points Not Allowed'lf
  79.     call writepkt('File request terminated: Points are not currently served.'cr)
  80.     Signal GoodBye
  81. end
  82.  
  83. if ~ReqUnlisted & ~Listed & ~Human then do
  84.     address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Unlisted Systems Not Supported!"
  85.     LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Unlisted System'lf
  86.     call writepkt('File request terminated: Unlisted System ('remote_address')'cr)
  87.     Signal GoodBye
  88. end
  89.  
  90. if EXCLUDE.0~=0 then
  91. do zz=1 to EXCLUDE.0
  92. /*    if upper(remote_address)=upper(Exclude.zz) then do  */
  93.     if MatchPattern(upper(remote_address),upper(Exclude.zz)) then do
  94.         address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Excluded Node!"
  95.         LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Excluded Node!'lf
  96.         call writepkt('File request terminated: Your system is not authorized to request files here.'cr)
  97.         Signal GoodBye
  98.     end
  99. end
  100.  
  101. /* Read Accounting Data */
  102. AcctFile=AcctPath||translate(remote_address,'...','#:/')
  103. if exists(AcctFile) then do
  104.     if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Reading Accounting Information"
  105.     call open('Acct',AcctFile,'R')
  106.     FirstDate=readln('Acct')
  107.     LastDate=readln('Acct')
  108.     NumReqs =readln('Acct')
  109.     ReqFiles=readln('Acct')
  110.     ReqBytes=readln('Acct')
  111.     LastBytes=readln('Acct')
  112.     UserCalls=readln('Acct')
  113.     call close('Acct')
  114.     if LastDate=Date() then UserCalls=UserCalls+1
  115.     else do
  116.         LastBytes=0
  117.         UserCalls=0
  118.     end
  119.     FirstCall=""
  120. end;else do
  121.     FirstDate=Date();LastDate=Date()
  122.     NumReqs=0;ReqFiles=0;ReqBytes=0;LastBytes=0;UserCalls=0
  123. end
  124.  
  125. if Human & (UserCalls > MaxCalls) then do
  126.     address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Human exceeded max calls!"
  127.     if human then call send(' Refusing Request! Human exceeded max calls!\r\n') 
  128.     LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Humans exceeded max calls'lf
  129.     call writepkt('File request terminated: Exceeded Maximum sessions per day.'cr)
  130.     Signal GoodBye
  131. end
  132.  
  133. if Human & (MaxHTotal~=0 & (ReqBytes > MaxHTotal)) then do
  134.     address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Human Total free bytes exceeded!"
  135.     if human then call send(' Refusing Request! Exceeded Total Free bytes for unregistered users!\r\n') 
  136.     LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Humans exceeded Total Free Bytes'lf
  137.     call writepkt('File request terminated: Exceeded Total Free Bytes - Registration required'cr)
  138.     Signal GoodBye
  139. end
  140. /* Read the REQ file */
  141. if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Reading "Infile 
  142. NumRequested=1
  143. if ~open('in',Infile,'R') then do
  144.     address "LOGPROC" 'Putlog 'loggroup time() Line "Unable to read "Infile
  145.     LogBuf=LogBuf||date() time() Line Infile' from 'remote_sysop' of 'remote_address' -> Not Found'lf
  146.     Signal GoodBye
  147. end
  148. do while ~eof('in')
  149.     FName.NumRequested=upper(readln('in'))
  150.     MName.NumRequested=""
  151.     if left(FName.NumRequested,1)=";" then iterate
  152.     if left(FName.NumRequested,3)="---" then iterate
  153.     if right(FName.NumRequested,1)=D2C('13') then FName.NumRequested=left(FName.NumRequested,Length(FName.NumRequested)-1)
  154.     if length(FName.NumRequested) < 1 then leave
  155.     Update.NumRequested=""
  156.     Password.NumRequested=""
  157.     if words(FName.NumRequested) > 1 then do
  158.         if left(word(FName.NumRequested,2),1)="!" then Password.NumRequested=SubStr(Word(FName.NumRequested,2),2)
  159.         if left(word(FName.NumRequested,2),1)="+" then Update.NumRequested=Word(FName.NumRequested,2)
  160.         else if left(word(FName.NumRequested,2),1)="-" then Update.NumRequested=Word(FName.NumRequested,2)
  161.         else if words(FName.NumRequested)=3 then do    
  162.             if left(word(FName.NumRequested,3),1)="!" then Password.NumRequested=SubStr(Word(FName.NumRequested,3),2)
  163.             if left(word(FName.NumRequested,3),1)="+" then Update.NumRequested=Word(FName.NumRequested,3)
  164.             else if left(word(FName.NumRequested,3),1)="-" then Update.NumRequested=Word(FName.NumRequested,3)
  165.         end
  166.         FName.NumRequested=word(FName.NumRequested,1)
  167.     end
  168.     NumRequested=NumRequested+1
  169. end
  170. call close('in')
  171. /* Number of Files Requested */
  172. NumRequested=NumRequested-1
  173.  
  174. if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Requests:"NumRequested
  175.  
  176. /* Find requested files */
  177. call FindRequests
  178.  
  179. /* Send result message */
  180. if debug then address "LOGPROC" 'Putlog 'loggroup time() Line "Building Response message"
  181. do a=1 to NumRequested
  182.     if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Request:"a Fname.a SendFName.a "Sent:"SendFName.a.SentFiles
  183.     
  184.     if (MaxReqNames > 0) & (a > MaxReqNames) then SendFName.a.SentFiles=1
  185.     do b=1 to SendFName.a.SentFiles
  186.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Request:"a Fname.a "Sent:"SendFName.a.b
  187.         if SendFName.a.b="File Not Found" then do
  188.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  189.             MsgBuf=MsgBuf||'Error: File Not Found or Password Missing/Invalid'cr||cr
  190.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: File Not Found'lf
  191.             if human then call send(' 'FName.a' -=> Error: File Not Found\r\n')
  192.             iterate
  193.         end
  194.         if SendFName.a.b="File Not Available" then do
  195.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  196.             MsgBuf=MsgBuf||'Error: File Is Not Available On This System'cr||cr
  197.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: File Missing ['Password.a']'lf
  198.             if human then call send(' 'FName.a' -=> Error: File Missing\r\n')
  199.             iterate
  200.         end
  201.         if SendFName.a.b="Bad Password" then do
  202.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  203.             MsgBuf=MsgBuf||'Error: File Not Found or Password Missing/Invalid'cr||cr 
  204.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Bad Password ['Password.a']'lf
  205.             if human then call send(' 'FName.a' -=> Error: Bad Password\r\n')
  206.             iterate
  207.         end
  208.         if SendFName.a.b="Too Many Bytes" then do
  209.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  210.             MsgBuf=MsgBuf||'Error: Request Exceeded Maximum Requests or Byte count'cr||cr 
  211.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Request Exceeded Byte count'lf
  212.             if human then call send(' 'FName.a' -=> Error: Request Exceeded Byte count\r\n')
  213.             iterate
  214.         end
  215.         if MaxReqNames>0 & a>MaxReqNames | SendFName.a.b="Too Many Requests" then do
  216.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  217.             MsgBuf=MsgBuf||'Error: Request Exceeded Maximum Requests or Byte count'cr||cr 
  218.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Request Exceeded Maximum Requests'lf
  219.             if human then call send(' 'FName.a' -=> Error: Request Exceeded Maximum Requests\r\n')
  220.             iterate
  221.         end
  222.         if SendFName.a.b="Exceeded Daily Limit" then do
  223.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  224.             MsgBuf=MsgBuf||'Error: Request Exceeded Daily Limit for Human requesters'cr||cr 
  225.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Request Exceeded Daily Limit for Human requesters'lf
  226.             if human then call send(' 'FName.a' -=> Error: Request Exceeded Daily Limit\r\n')
  227.             iterate
  228.         end
  229.         if SubWord(SendFName.a.b,1,3)="Update request failed:" then do
  230.             MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  231.             MsgBuf=MsgBuf||'Date : 'JDate.a.b||cr'Error: 'SendFName.a.b||cr||cr
  232.             LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: 'SendFName.a.b||lf
  233.             if human then call send(' 'FName.a' -=> Error: Update request failed\r\n')
  234.             iterate
  235.         end;else do
  236.             Sent=Sent+1
  237.             if MName.a.b~="" then do
  238.                 MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a' Sent:'MName.a.b||cr
  239.                 MsgBuf=MsgBuf||'Size : 'FSize.a.b' bytes'cr'Desc : 'FDesc.a.b||cr||cr
  240.                 LogBuf=LogBuf||date() time()' 'FName.a '['MName.a.b'] ('FSize.a.b' bytes)'lf
  241.             end;else do
  242.                 MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
  243.                 MsgBuf=MsgBuf||'Size : 'FSize.a.b' bytes'cr'Desc : 'FDesc.a.b||cr||cr
  244.                 LogBuf=LogBuf||date() time()' 'FName.a' ('FSize.a.b' bytes)'lf
  245.             end
  246.         end
  247.     end
  248. end
  249.  
  250. if (MaxReqNames > 0) & (NumRequested > MaxReqNames) then do
  251.    MsgBuf=MsgBuf||'Remaining Requests skipped for exceeding request limits'cr
  252.    if human then call send(' 'FName.a' -=> Error: Remaining Requests skipped for exceeding request limits\r\n'
  253. end
  254. MsgBuf=MsgBuf||cr'Sending 'Sent' file(s), 'TBytes' bytes this request.'cr
  255. MsgBuf=MsgBuf||cr'You have made a total of 'NumReqs+1' FileRequest(s) for 'ReqFiles+Sent' files ('ReqBytes+TBytes' bytes)'cr
  256. MsgBuf=MsgBuf||cr'Files were requested from 'script sv' on 'host_address||cr
  257.  
  258. call writepkt(MsgBuf)
  259.  
  260. LogBuf=LogBuf||date() time()' Sending 'Sent' file(s), 'TBytes' bytes this request'lf
  261. LogBuf=LogBuf||date() time()' Totals: 'NumReqs+1' request(s) for 'ReqFiles+Sent' file(s) ('ReqBytes+TBytes' bytes)'lf
  262.  
  263. /* Update the account */
  264. AccBuf=AccBuf||FirstDate||lf||Date()||lf||NumReqs+1||lf||ReqFiles+Sent||lf
  265. AccBuf=AccBuf||ReqBytes+TBytes||lf||LastBytes+TBytes||lf||UserCalls||lf
  266.  
  267. if Human then do
  268.     ctlfile="T:"||translate(remote_sysop,"_"," ")||".lst"
  269.     call open('ctx',ctlfile,'w')
  270.     call writech('ctx',HydraFiles)
  271.     call close('ctx')
  272. end
  273. Signal GoodBye
  274.  
  275. FindRequests:
  276. Num=NumRequested /* Limit number of REQUEST NAMES to MaxReqNames */
  277. if (MaxReqNames~=0) & (NumRequested > MaxReqNames) then Num=MaxReqNames
  278.  
  279. do ReqCount=1 to Num
  280.     address "LOGPROC" 'PutLog 'loggroup time() Line script "Searching for Req:"ReqCount":"FName.ReqCount" in "FREQLST
  281.     SentCount=1;notfound=1
  282.     SendFName.ReqCount.SentCount="File Not Found"
  283.     sopt=""
  284.     if SortedLst=TRUE then sopt="-s"
  285.     if MatchFirst=TRUE then do
  286.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Executing: Fsearch >"tlist FREQLST Fname.ReqCount "-o" sopt
  287.         address COMMAND 'Fsearch >'tlist FREQLST Fname.ReqCount '-o' sopt
  288.     end;else do
  289.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Executing: Fsearch >"tlist FREQLST Fname.ReqCount sopt
  290.         address COMMAND 'Fsearch >'tlist FREQLST Fname.ReqCount sopt
  291.     end
  292.  
  293.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Searching match list:"tlist
  294.     call open('tq',tlist,'r')
  295.     do while ~eof('tq')
  296.         SearchResult=strip(readln('tq'))
  297.         if SearchResult="" then Iterate
  298.         if SearchResult="!@ No match found" then do
  299.             SendFName.ReqCount.SentCount="File Not Found"
  300.             Leave
  301.         end
  302.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "SearchResult:"SearchResult
  303.         if MatchFirst=TRUE then do
  304.             /* if not a magic name then we send only the first file matched */
  305.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "MATCHFIRST:"SearchResult
  306.             call sendifok
  307.             Leave
  308.         end
  309.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "MULTIMATCH:"SentCount SearchResult
  310.         call sendifok
  311.         SentCount=SentCount+1
  312.         if MultiMagic=TRUE | MatchFirst=FALSE then Iterate
  313.             else Leave
  314.     end /* tag matches in search list */
  315.     call close('tq') 
  316.     if ~debug then call delete(tlist)
  317.     if SentCount=0 then SendFname.ReqCount.SentFiles=1
  318.         else if SentCount > 1 then SendFname.ReqCount.SentFiles=SentCount-1  
  319.             else SendFname.ReqCount.SentFiles=SentCount
  320.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "SentCount:"SentCount SendFname.ReqCount.SentFiles
  321. end /* each request NAME */
  322. Return
  323.  
  324. sendifok:
  325. /* check file match for bytes exceeded, password match, update request */
  326. sendit=TRUE
  327. if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Checking:" SearchResult
  328. if index(SearchResult,'!')=0 then do
  329.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "No Password Set:" SearchResult
  330.     SendFname.ReqCount.SentCount=upper(subword(SearchResult,2))
  331. end;else do 
  332.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Password Check:" SearchResult "{"upper(Password.ReqCount)"}"
  333.     if upper(Password.ReqCount)~=strip(upper(delstr(word(SearchResult,2),1,1))) then do
  334.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Bad Password!"
  335.         SendFName.ReqCount.SentCount="Bad Password"
  336.         sendit=FALSE
  337.     end;else do
  338.         SendFname.ReqCount.SentCount=upper(subword(SearchResult,3))
  339.     end
  340. end
  341.  
  342. if ~sendit then return sendit
  343.  
  344. if ~exists(SendFName.ReqCount.SentCount) then do
  345.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "File Missing:"SendFName.ReqCount.SentCount
  346.     SendFName.ReqCount.SentCount="File Not Available"
  347.     sendit=FALSE
  348. end;else do
  349.     FName.ReqCount.SentCount=get_fn(SendFName.ReqCount.SentCount)
  350.     filestats=statef(SendFName.ReqCount.SentCount)
  351.     FSize.ReqCount.SentCount=word(filestats,2)
  352.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line FName.ReqCount.SentCount" Size:" FSize.ReqCount.SentCount
  353.     TBytes=TBytes+FSize.ReqCount.SentCount
  354.     if MaxBytes > 0 then do
  355.         if (TBytes > MaxBytes) then do
  356.             SendFName.ReqCount.SentCount="Too Many Bytes"
  357.             TBytes=TBytes-FSize.ReqCount.SentCount
  358.             sendit=FALSE
  359.         end
  360.     end
  361.  
  362.     if ~Human & (MaxDaily > 0) then do
  363.         if (TBytes+LastBytes > MaxDaily) then do
  364.             SendFName.ReqCount.SentCount="Exceeded Daily Limit"
  365.             TBytes=TBytes-FSize.ReqCount.SentCount
  366.             sendit=FALSE
  367.         end
  368.     end 
  369.  
  370.     if Human & (MaxHDaily > 0) then do
  371.         if (TBytes+LastBytes > MaxHDaily) then do
  372.             SendFName.ReqCount.SentCount="Exceeded Daily Limit"
  373.             TBytes=TBytes-FSize.ReqCount.SentCount
  374.             sendit=FALSE
  375.         end
  376.     end
  377.  
  378.     FDesc.ReqCount.SentCount=subword(filestats,8)
  379.     if FDesc.ReqCount.SentCount="" then FDesc.ReqCount.SentCount="Sorry, description is unavailable"
  380.  
  381.     if DLGfd then FDesc.ReqCount.SentCount=get_dlgfd()
  382.     else if TAdesc then FDesc.ReqCount.SentCount=get_tadesc()
  383.  
  384.     if Update.ReqCount ~="" then do
  385.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Update Request:"Update.ReqCount
  386.         UDT.ReqCount=left(Update.ReqCount,1)
  387.         if substr(Update.ReqCount,2,1)="U" then do
  388.             Update.ReqCount=SubStr(Update.ReqCount,3)
  389.             UDT.Human=TRUE
  390.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "QS/RFS Update Request:"Update.ReqCount
  391.         end;else do
  392.             Update.ReqCount=SubStr(Update.ReqCount,2)
  393.             UDT.Human=FALSE
  394.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "FTS006 Update Request:"Update.ReqCount
  395.         end
  396.         if UDT.Human then do
  397.             if length(strip(Update.ReqCount)) >6 then do    
  398.                 cktime=TRUE
  399.                 cmd='List DATES 'SendFName.ReqCount.SentCount' LFORMAT="%D%T" TO 'ulist 
  400.             end;else do   
  401.                 cktime=FALSE
  402.                 cmd='List DATES 'SendFName.ReqCount.SentCount' LFORMAT="%D" TO 'ulist
  403.             end
  404.             Address Command cmd
  405.             call open('UFile',ulist,'R')
  406.             UpDt.ReqCount.SentCount=readln('UFile')
  407.             call close('UFile')
  408.             if ~debug then call Delete(ulist)
  409.             if cktime then UpDt.ReqCount.SentCount=space(translate(UpDt.ReqCount.SentCount,"",":"),0)
  410.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "File Date Read:"UpDt.ReqCount.SentCount
  411.  
  412.             Mon=right('00'||(pos(substr(UpDt.ReqCount.SentCount,4,3),'JanFebMarAprMayJunJulAugSepOctNovDec')+2)/3,2)
  413.  
  414.             if cktime then Jdate.ReqCount.SentCount=right(UpDt.ReqCount.SentCount,2)||Mon||left(UpDt.ReqCount.SentCount,2)||right(UpDt.ReqCount.SentCount,8)
  415.                 else Jdate.ReqCount.SentCount=right(UpDt.ReqCount.SentCount,2)||Mon||left(UpDt.ReqCount.SentCount,2)
  416.  
  417.             if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "File Date Calc:"Jdate.ReqCount.SentCount
  418.         end;else do
  419.             /* FTS006 update request */
  420.             x=statef(SendFName.ReqCount.SentCount)
  421.             JDate.ReqCount.SentCount=(86400 * 365 * 8)+(2 * 86400)+(((word(x,5))*86400)+(word(x,6)*60))
  422.         end
  423.         if (UDT.ReqCount="+") & (JDate.ReqCount.SentCount < Update.ReqCount) then do
  424.             SendFName.ReqCount.SentCount="Update request failed: File older than requested."
  425.             sendit=FALSE
  426.         end
  427.         if (UDT.ReqCount="-") & (JDate.ReqCount.SentCount > Update.ReqCount) then do
  428.             SendFName.ReqCount.SentCount="Update request failed: File newer than requested."
  429.             sendit=FALSE
  430.         end
  431.         if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line SendFName.ReqCount.SentCount
  432.     end 
  433. end
  434. if sendit then do
  435.     /* get FileName returned for a magic request */
  436.     Mname.ReqCount.SentCount=get_fn(SendFname.ReqCount.SentCount)
  437.     if Fname.ReqCount=Mname.ReqCount.SentCount then Mname.ReqCount.SentCount=""
  438.     if ~debug then call queueadd(SendFName.ReqCount.SentCount,XQ_IMMEDIATE)
  439.         else address "LOGPROC" 'PutLog 'loggroup time() Line script "Queued" SendFname.ReqCount.SentCount
  440. end
  441. return sendit
  442.  
  443. writepkt:
  444. if Human then do
  445.     cr='0a'x;packet_name="T:"||translate(strip(remote_sysop),'_'," ")||"."||date("I")||time("S")
  446.     pbuf=""
  447. end;else do
  448.     magicnum=x2d(time('s'))+randu(x2d(Pragma('ID')))+ (randu(x2d(time('s')) ) * 999999)+(random() * 1000000)  
  449.     serial=reverse(right("0000"x||c2x(magicnum), 8))
  450.     packet_name="T:"||serial||".PKT"
  451.  
  452.     /* create some data in packet format */
  453.     d=date("S");t=time("N")
  454.     parse var t hh":"mm":"ss
  455.     yr=reverse(right("00"x||d2c(left(d,4)),2))
  456.     mh=reverse(right("00"x||d2c((substr(d,5,2)-1)),2))
  457.     dy=reverse(right("00"x||d2c(substr(d,7,2)),2))
  458.     hr=reverse(right("00"x||d2c(hh),2))
  459.     mn=reverse(right("00"x||d2c(mm),2))
  460.     sc=reverse(right("00"x||d2c(ss),2))
  461.  
  462.     zo=reverse(right("00"x||d2c(myaddress.zone),2))
  463.     ndo=reverse(right("00"x||d2c(myaddress.node),2))
  464.     nto=reverse(right("00"x||d2c(myaddress.net),2))
  465.     po=reverse(right("00"x||d2c(myaddress.point),2))
  466.  
  467.     zd=reverse(right("00"x||d2c(hisaddress.zone),2))
  468.     ndd=reverse(right("00"x||d2c(hisaddress.node),2))
  469.     ntd=reverse(right("00"x||d2c(hisaddress.net),2))
  470.     pd=reverse(right("00"x||d2c(hisaddress.point),2))
  471.  
  472.     pbuf=ndo||ndd||yr||mh||dy||hr||mn||sc||copies("00"x,2) ||"0200"x||nto||ntd||"DA"x||d2c(substr(sv,2,2))||copies("00"x, 8)
  473.     pbuf=pbuf||zo||zd||copies("00"x,2)||reverse(right("01"x||"00"x,2))||"00"x||d2c(substr(sv,5,2))||reverse(right("00"x||"01"x,2))
  474.     pbuf=pbuf||zo||zd||po||pd||"ROOF"||"0200"x||ndo||ndd||nto||ntd||"11000000"x||left(date(),6) right(date(),2) "" right("0"||time(),8)||"00"x||remote_sysop||"00"x
  475.     pbuf=pbuf||sysop||"00"x||"Results of your file request"||"00"x
  476.     if myaddress.zone~=hisaddress.zone then pbuf=pbuf||"01"x||"INTL" hisaddress.zone":"hisaddress.net"/"hisaddress.node myaddress.zone":"myaddress.net"/"myaddress.node||cr
  477.         else pbuf=pbuf||"01"x||"MSGTO:" hisaddress.zone":"hisaddress.net"/"hisaddress.node||cr
  478.     if myaddress.point~=0 then pbuf=pbuf||"01"x||"FMPT" myaddress.point||cr
  479.     if hisaddress.point~=0 then pbuf=pbuf||"01"x||"TOPT" hisaddress.point||cr
  480.     pbuf=pbuf||"01"x||"MSGID: "myaddress.zone':'myaddress.net'/'myaddress.node'.'myaddress.point' 'd2x((date('I') * 86400)+time("S")+252460600)||cr||"01"x||"PID: "script sv||cr
  481. end /* Not Human */
  482.  
  483.     pbuf=pbuf||"      Presenting "script sv", the ARexx/WPL/XFREQ File Request Server"cr||cr
  484.     if Header~="" then pbuf=pbuf||cr||Header||cr
  485.     if exists(AcctFile||'.M') then call addmsg
  486.     if FirstCall~="" then pbuf=pbuf||cr||FirstCall||cr
  487.  
  488.     if Human then pbuf=pbuf||cr'The following are the results of your Grab session:'cr||cr
  489.         else pbuf=pbuf||cr'The following are the results of your File Request:'cr||cr
  490.  
  491.     pbuf=pbuf||arg(1)||cr||cr
  492.  
  493.     If Tail~="" & ~Human then  pbuf=pbuf||cr||Tail||cr
  494.  
  495.     If Human & Listed & VHuman~="" then pbuf=pbuf||cr||VHuman||cr
  496.  
  497.     pbuf=pbuf||cr||"--- The Roof File Request Server "sv||cr||cr
  498.     if ~Human then pbuf=pbuf||"000000"x
  499.  
  500.     if ~open('packet',packet_name,"W") then do
  501.         address "LOGPROC" 'PutLog 'loggroup time() Line script "Couldn't open packet-file ["packet_name"]"
  502.         return 20
  503.     end
  504.     call writech('packet',pbuf)
  505.     call close('packet')
  506.     if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Queueing response packet" packet_name
  507.     call queueadd(packet_name, XQ_IMMEDIATE+XQ_DELETE)
  508. return 0
  509.  
  510.     
  511. addmsg:
  512. call open('am',AcctFile||'.M','R')
  513. pbuf=pbuf||" The sysop left this personal message for you:"||cr
  514. do while ~eof('am')
  515.     mline=readln('am')
  516.     y=pos(cr,mline)
  517.     if y~=0 then pbuf=pbuf||mline
  518.         else pbuf=pbuf||mline||cr
  519. end
  520. call close('am')
  521. call delete(AcctFile||'.M')
  522. return
  523.  
  524.  
  525. send:
  526. Address VALUE upper(wplport)||line
  527. 'Print' quote||arg(1)||quote
  528. 'Send' quote||arg(1)||quote
  529. Address
  530. return
  531.  
  532. queueadd:
  533. if debug then return
  534. file=upper(arg(1))
  535. flags=arg(2)
  536. sendas=get_fn(file)
  537. if Human then HydraFiles=HydraFiles||file sendas||'0a'x
  538. work=NULL
  539. QUERY.XQ_NAME=file
  540. QUERY.XQ_SITE=xfq_site_object
  541. work=XfqFindWork(QUERY)
  542. if work=NULL then do
  543.     if ~XfqAddWorkQuick(remote_address,file,sendas,120,flags) then do
  544.         address "LOGPROC" 'PutLog 'loggroup time() Line script 'Queue 'file' Failed:'XFQERRORMSG remote_address
  545.         drop XFQERRORCODE XFQERRORMSG
  546.     end;else do
  547.         address "LOGPROC" 'PutLog 'loggroup time() Line script 'Queued 'file' as' sendas
  548.         if Human then call send(' Sending 'file' as 'sendas'\r\n')
  549.     end
  550. end;else do
  551.     call XfqUnlockWork(work)
  552.     address "LOGPROC" 'PutLog 'loggroup time() Line script file 'already queued'
  553. end
  554. if work~=NULL then call XfqDropObject(work)
  555. return 0
  556.  
  557. get_dlgfd:
  558. fn=translate(FDesc.ReqCount.SentCount,"",'1b'x)
  559. if ~open('dx',fn,'r') then return "Sorry, DLG description is unavailable"
  560. tmpbuf=readch('dx',word(statef(fn),2))
  561. call close('dx')        
  562. return substr(tmpbuf,lastpos('00'x,tmpbuf)+1)
  563.  
  564. get_tadesc:
  565. fn=SendFName.ReqCount.SentCount||'.desc'
  566. if ~open('dx',fn,'r') then return "Sorry, TransAmiga description is unavailable"
  567. tmpbuf=readch('dx',word(statef(fn),2))
  568. call close('dx')        
  569. return tmpbuf
  570.  
  571. /* get filename */
  572. get_fn:
  573. if LastPos('/', arg(1))~=0 then return SubStr(arg(1), LastPos('/', arg(1))+1)
  574.     else if LastPos(':', arg(1))~=0 then return SubStr(arg(1), LastPos(':', arg(1))+1)
  575.         else return arg(1)
  576.  
  577.  
  578. setconfig:
  579. if ~open('cfg',"RAM:RFS.cfg",'r') then 
  580.     if ~open('cfg',"CFG:RFS.cfg",'r') then address "LOGPROC" 'PutLog 'loggroup time() Line 'RFS cfg failed'
  581.     do while ~eof('cfg')
  582.         x=readln('cfg')
  583.         if x="" | left(x,1)=" " | left(x,2)='/*' | left(x,2)='*/' then iterate
  584.         interpret x
  585.     end
  586. call close('cfg')
  587. return
  588.  
  589. lower:
  590. return(bitor(arg(1),'20'x))
  591.  
  592.  
  593. Syntax:
  594. call template_oops "Syntax(RC="||RC||")" sigl RC
  595. IOErr:
  596. call template_oops "IOErr" sigl
  597. template_oops: 
  598. parse arg what badline code
  599. if code~="" then  LogBuf=LogBuf||date() time() "ERR:"what errortext(code)||lf
  600.     else LogBuf=LogBuf||date() time() "ERR:"what||lf
  601. LogBuf=LogBuf||date() time() "ERR: Line:"badline strip(sourceline(badline))||lf
  602. GoodBye:
  603. x=XfqReleaseMailer(xfq_site_object)
  604. call XfqDropObject(xfq_site_object)
  605. if work~=NULL then call XfqDropObject(work)
  606. call XfqClose()
  607.  
  608. if AccBuf~="" then do
  609.     address "LOGPROC" 'PutLog 'loggroup time() Line "Updating account"
  610.     call open('Acct',AcctFile,'W')
  611.     call Writech('Acct',AccBuf||lf)
  612.     call close('Acct')
  613. end
  614.  
  615. LogBuf=LogBuf||date() time()' RFS session Ending'lf
  616.  
  617. if LogFile~="" then do
  618.     if exists(LogFile) then call open('log',LogFile,'A')
  619.         else call open('log',LogFile,'W')
  620.     call writech('log',LogBuf||lf)
  621.     call close('log')
  622. end;else do
  623.     i=1
  624.     loglen=length(LogBuf)
  625.     do while i < loglen+1
  626.         alen=pos('0a'x, LogBuf, i)-i
  627.         aline=substr(body,i,alen)
  628.         address "LOGPROC" 'PutLog 'loggroup Line aline
  629.         i=i+alen+1
  630.     end
  631. end
  632. if ~debug then call delete(infile)
  633. address "LOGPROC" 'PutLog 'loggroup time() Line 'RFS session with' remote_address 'terminated'
  634. Exit
  635.  
  636. /*
  637.   I've modified the routine to fetch the file comments from a DLG system
  638. and am including it here for you to implement into RFS if you would like.
  639. Also included is the routine to get the descriptions from an Excelsior!
  640. BBS.
  641.  
  642. Call with something like this:
  643.  
  644. Info = StateF(FileName)
  645. Path = SubWord(Info,8)
  646. Comment = GetDLGDesc(Path)
  647. If Comment = "NOCOMMENT" then Comment = DefaultComment
  648. */
  649. /*
  650. GetDLGDesc: Procedure
  651.   Arg DLGName
  652.   FN = Translate(DLGName,"","1b"x)
  653.   If ~Exists(FN) then Return "NOCOMMENT"
  654.   If ~Open('dx',FN,'r') then Return "NOCOMMENT"
  655.   TmpBuf = ReadCh('dx',Word(StateF(FN),2))
  656.   TmpBuf = SubStr(TmpBuf,LastPos('00'x,TmpBuf)+1)
  657.   TmpBuf = Translate(TmpBuf,' ','0a'x)
  658.   If Pos('0d'x,TmpBuf)>0 then TmpBuf=SubStr(TmpBuf,1,Pos('0d'x,TmpBuf)-1)
  659.   Call Close('dx')
  660.   Drop DLGName
  661.   Return Strip(TmpBuf)
  662. */
  663.  
  664. /*
  665. For  the Excelsior BBS option, I use this routine to fetch the description.
  666. A  bit more complex, but that's the nature of the data files that Excelsior
  667. uses.
  668.     Used by permission Roger Clark
  669.  
  670. Comment=GetExcelDesc(Path||FileName)
  671. If Comment="NOCOMMENT" then comment=DefaultComment
  672. */
  673. /*
  674. GetExcelDesc: Procedure
  675. Arg FilePath
  676. TempComment = ""
  677. TempPath = Translate(FilePath," ",":")
  678. TempPath = Translate(TempPath," ","/")
  679. TempFile = Word(TempPath,Words(TempPath))
  680. TempPath = Left(FilePath,Length(FilePath)-Length(TempFile))
  681. If ~Exists(TempPath"_itemdata") then Return "NOCOMMENT"
  682. Call Open("Items",TempPath"_itemdata","R")
  683. FSize = Word(StateF(TempPath"_itemdata"),2)
  684. fileX = 0
  685. Do Forever
  686.     If fileX * 170 >= FSize then Break
  687.     FileName = ""
  688.     Call Seek("Items",(filex*170),"B")
  689.     Do Forever
  690.         Char=ReadCH("Items")
  691.         If Char="00"x then Leave
  692.         FileName=FileName||Char
  693.     End
  694.     fileX=fileX+1
  695.     If Upper(FileName) = Upper(TempFile) then Do
  696.         Call Open("Data",TempPath"_Comments","R")
  697.         OffSet = ((fileX-1) * 170) + 110
  698.         Call Seek("Items",OffSet,"B")
  699.         Pos=C2D(ReadCH("Items",4))
  700.         Call Seek("Data",Pos,"B")
  701.         Do Until Left(EComment,1) = "01"x
  702.             EComment = ReadLn("Data")
  703.             TempComment = TempComment||"0a"x||EComment
  704.         End
  705.         Call Close("Data")
  706.         TempComment = Translate(TempComment,"","01"x)
  707.         TempComment = Strip(TempComment,"B","0a"x)
  708.         TempComment = Translate(TempComment,"0d"x,"0a"x)
  709.         If Pos("0d"x,TempComment) > 0 then Do
  710.             NComment = ""
  711.             Do CLoop = 1 to Length(TempComment)
  712.                 NComment = NComment||SubStr(TempComment,CLoop,1)
  713.                 If SubStr(TempComment,CLoop,1)="0d"x then NComment=NComment||"       "
  714.             End
  715.             TempComment = Strip(NComment,"T")
  716.         End
  717.     End
  718. End
  719. Call Close("Items")
  720. If TempComment = "" then TempComment = DefaultComment
  721. Return TempComment
  722. */
  723. /*
  724. Today=Date("S")
  725. CompDate=Right(Today,2)||" "||SubStr("JanFebMarAprMayJunJulAugSepOctNovDec",((SubStr(Today,5,2)-1)*3)+1,3)||" "||SubStr(Today,3,2)||"  "||Time()
  726. pbuf=pbuf||CompDate||"00"x||remote_sysop||"00"x
  727. */
  728.